VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsFakeRegistry"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private m_sFileName As String
Private m_obj As New Collection
Private m_objKey As New Collection

Friend Sub Clear()
Set m_obj = New Collection
Set m_objKey = New Collection
End Sub

Friend Sub LoadFile(ByVal fn As String)
On Error Resume Next
Dim ff As Long
Dim s As String
Dim sKey As String, sSubKey As String, sValue As String
Dim obj As Collection
'///
Clear
'///
m_sFileName = fn
ff = FreeFile
Err.Clear
Open fn For Input As #ff
If Err.Number = 0 Then
 Do Until EOF(ff)
  Err.Clear
  Line Input #ff, s
  If Err.Number Then Exit Do
  Select Case Left(s, 1)
  Case "K" 'key
   If Not obj Is Nothing Then
    m_obj.Add obj, sKey
    m_objKey.Add sKey, sKey
   End If
   sKey = Mid(s, 3)
   Set obj = New Collection
  Case "S" 'subkey
   sSubKey = Mid(s, 3)
   Line Input #ff, s
   If Err.Number Then Exit Do
   If Left(s, 1) = "V" Then 'value
    sValue = Mid(s, 3)
    obj.Add sSubKey + vbNullChar + sValue, sSubKey
   End If
  End Select
 Loop
End If
'///
If Not obj Is Nothing Then
 m_obj.Add obj, sKey
 m_objKey.Add sKey, sKey
End If
'///
Close ff
End Sub

Friend Sub SaveFile(Optional ByVal fn As String)
On Error Resume Next
Dim ff As Long
Dim v As Variant, v2 As Variant
Dim sKey As String, sSubKey As String, sValue As String, i As Long
Dim obj As Collection
'///
If fn = vbNullString Then fn = m_sFileName
If fn = vbNullString Then Exit Sub
m_sFileName = fn
'///
ff = FreeFile
Err.Clear
Open fn For Output As #ff
If Err.Number = 0 Then
 For Each v In m_objKey
  sKey = v
  Set obj = Nothing
  Set obj = m_obj.Item(sKey)
  If Not obj Is Nothing Then
   Print #ff, "K " + sKey
   For Each v2 In obj
    sSubKey = v2
    i = InStr(1, sSubKey, vbNullChar)
    If i > 0 Then
     sValue = Mid(sSubKey, i + 1)
     sSubKey = Left(sSubKey, i - 1)
     Print #ff, "S " + sSubKey
     Print #ff, "V " + sValue
    End If
   Next v2
  End If
 Next v
End If
'///
Close ff
End Sub

Friend Function GetKeyValue(ByVal KeyName As String, ByVal SubKeyRef As String, ByRef KeyVal As String) As Boolean
On Error Resume Next
'///
Dim obj As Collection
Dim s As String, i As Long
'///
KeyVal = vbNullString
Set obj = m_obj.Item(KeyName)
If Not obj Is Nothing Then
 Err.Clear
 s = obj.Item(SubKeyRef)
 i = InStr(1, s, vbNullChar)
 If Err.Number = 0 And i > 0 Then
  KeyVal = Mid(s, i + 1)
  GetKeyValue = True
 End If
End If
End Function

Friend Function SetKeyValue(ByVal KeyName As String, ByVal SubKeyRef As String, ByVal KeyVal As String) As Boolean
On Error Resume Next
'///
Dim obj As Collection
Dim s As String, i As Long
'///
Set obj = m_obj.Item(KeyName)
If obj Is Nothing Then
 Set obj = New Collection
 Err.Clear
 m_objKey.Add KeyName, KeyName
 m_obj.Add obj, KeyName
 If Err.Number Then
  Debug.Assert False
  Exit Function
 End If
End If
'///
obj.Remove SubKeyRef
obj.Add SubKeyRef + vbNullChar + KeyVal, SubKeyRef
SetKeyValue = True
End Function

Private Sub Class_Terminate()
SaveFile
End Sub
